(** 
    Breadth.ml

    Bozman Çagdas <bozman.cagdas@gmail.com> - 2011
    Razakamiadana Tefin <tefy.razaka@gmail.com>   - 2011
*)

open Sets
open Utils

let clear_fifo_in_res fifo res = 
  Queue.fold (fun res (x,_) -> StringSet.add x res) res fifo
    
let left link_req dist res compact_list = 
  let pop_until dist distL fifo =
    let rec aux dist distL fifo =
      let _, nb = Queue.take fifo in
      let distL = distL - (int_of_string nb) in
      if distL > dist then aux dist distL fifo
      else distL
    in
    try 
      aux dist distL fifo 
    with Queue.Empty -> 0
  in
  let fifoL = Queue.create () in
  let rec left_aux link_req dist res distL = function
    | [] -> res
    | [ lnk ] -> 
	if (Link.compare link_req lnk) then clear_fifo_in_res fifoL res else res
    | lnk :: dist_loc :: tl ->
	if Link.compare link_req lnk then 
	  let res = clear_fifo_in_res fifoL res in
	    left_aux link_req dist res 0 tl
	else
	  let distL = distL + (int_of_string dist_loc) in
	  let _ = Queue.add (lnk, dist_loc) fifoL in
	    if distL > dist then 
	      let distL = pop_until dist distL fifoL in
		left_aux link_req dist res distL tl
	    else left_aux link_req dist res distL tl
  in
    left_aux link_req dist res 0 compact_list
      
let right link_req dist res = 
  let fifoR = Queue.create () in 
    function
      | [] -> res
      | lnk :: tl -> 
	  let rec right_aux flag link_req dist res distR compact_list = 
	    match compact_list with 
	      | []    -> res
	      | [ _ ] -> clear_fifo_in_res fifoR res
	      | dist_loc :: lnk :: [] -> 
		  if Link.compare link_req lnk then clear_fifo_in_res fifoR res
		  else
		    let _ = 
		      if flag then
			let new_distR =  distR + (int_of_string dist_loc) in
			  if new_distR < dist then Queue.add (lnk,dist_loc) fifoR 
		    in
		      clear_fifo_in_res fifoR res
	      | dist_loc :: lnk :: tl ->
		  if Link.compare link_req lnk then 
		    let res = clear_fifo_in_res fifoR res in
		      right_aux true link_req dist res 0 tl
		  else
		    if flag then
		      let new_distR =  distR + (int_of_string dist_loc) in
			if new_distR > dist then right_aux false link_req dist res distR tl
			else 
			  let _ = Queue.add (lnk,dist_loc) fifoR in
			    right_aux true link_req dist res new_distR tl		  
		    else right_aux false link_req dist res distR tl
	  in 
	    right_aux (Link.compare link_req lnk) link_req dist res 0 tl
	      
let get_text str =
  let reg_txt = Str.regexp "<wikitext.*>\\(.*\\)</wikitext>" in
  let str = Str.global_replace (Str.regexp "\n") " " str in
  let _ = Str.string_match reg_txt str 0 in
    from_group str 1
      
let get_all_struct titles =
  let aux t =
    debug "   ... getting wikitext for [%s] ... \n" t; flush stderr;
    let page = Page.init t in
    let str = get_text (Page.wiki_text page) in 
      Compact.get_struct str
  in
    StringSet.fold (fun x res -> let l = aux x in (l :: res)) titles []
      
let bfs word dist stop =
  debug "Getting links for [L %s <= %d] ... \n" word dist; flush stderr;
  if !stop || dist = 0 || Str.string_match ignore word 0
  then StringSet.empty
  else
    let page = Page.init word in
    let titles = Page.backlinks_titles page in
    let struct_list = get_all_struct titles in
    let rec aux res = function
      | [] -> res
      | l :: ls ->
	  if !stop then StringSet.empty
	  else
	    let res = left word dist res l in
	    let res = right word dist res l in
	      aux res ls 
    in 
      aux StringSet.empty struct_list      
